home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0188.ZIP / ITRMMISC.INC < prev    next >
Text File  |  1985-02-20  |  2KB  |  86 lines
  1. procedure scan(var extend : boolean; var code : byte);
  2. {
  3.  Uses MSDOS service 7 to get a keystroke w/o echo. Sets 'extend' true
  4.  for extended codes from PC-Clone keyboards, and returns ASCII/Scan code
  5.  in 'code'
  6. }
  7. const
  8.      SERVICE_7 = $700;                 {set CPU register AX for DOS service 7}
  9.      MASK_AH = $FF;                    {service 7 returns code in AL}
  10. type
  11.     reg88 = record
  12.           ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  13.     end;
  14. var
  15.    r : reg88;
  16.    c : integer;
  17. begin
  18.      r.ax := SERVICE_7;
  19.      MsDos(r);
  20.      code := r.ax and MASK_AH;
  21.      extend := false;
  22.      if  code = 0 then
  23.      begin
  24.         extend := true;
  25.         MsDos(r);
  26.         code := r.ax and MASK_AH
  27.      end
  28. end;
  29.  
  30. function exists(fname :  bigstring) : boolean;
  31. var
  32.    f : file;
  33. begin
  34.      assign(f, fname);
  35.      {$I-}
  36.      reset(f);
  37.      {$I+}
  38.      if IOresult = 0 then
  39.         begin
  40.              exists := true;
  41.              close(f)
  42.         end
  43.      else
  44.         exists := false
  45. end;
  46.  
  47. procedure supcase(var s);
  48. var
  49.    ss : bigstring absolute s;
  50.    i : integer;
  51. begin
  52.      for i := 1 to length(ss) do
  53.          ss[i] := upcase(ss[i])
  54. end;
  55.  
  56. type
  57.     DiskFile = file of byte;
  58.     stream   = ^diskfile;
  59.  
  60. function fopen(var name : bigstring; mode : char) : stream;
  61. Var
  62.    ls : stream;
  63.    FileExists : boolean;
  64. begin
  65.      ls := NIL;
  66.      mode := upcase(mode);
  67.      FileExists := exists(name);
  68.      if FileExists or (mode = 'W') then
  69.      begin
  70.        new(ls);
  71.        assign(ls^,name)
  72.      end;
  73.      case mode of
  74.           'R', 'A' : begin
  75.                        if FileExists then
  76.                        begin
  77.                           reset(ls^);
  78.                           if mode = 'A' then
  79.                              seek(ls^,filesize(ls^))
  80.                        end
  81.                      end;
  82.                'W' : rewrite(ls^);
  83.      end;
  84.      fopen := ls
  85. end;
  86.